home *** CD-ROM | disk | FTP | other *** search
/ InterCD 1999 June / june_1999.iso / Bookmarks / Address Organizer / _SETUP.1 / geturl.cgi < prev    next >
Encoding:
Text File  |  1998-01-26  |  957 b   |  49 lines
  1. #!/usr/bin/perl
  2.  
  3. # GetURL CGI
  4. # Copyright 1998 Geniusworks
  5.  
  6. &parse_form;
  7.  
  8. $url = $input{'url'};
  9.  
  10. if ($url gt "") {
  11.   &goto_url;
  12.   exit;
  13. }
  14.  
  15. &badpassword;
  16. exit;
  17.  
  18. sub badpassword {
  19.   print "Content-type: text/html\n\n";
  20.   print "<HTML>\n";
  21.   print "<HEAD><TITLE>Invalid URL.</TITLE></HEAD>\n";
  22.   print "<BODY BGCOLOR=#FFFFFF TEXT=#000000 LINK=#0000FF VLINK=#800040 ALINK=#800040\n";
  23.   print "<CENTER><H2>The link you selected is invalid.<BR>Click \"Back\" and try again.</H2></CENTER><BR>\n";
  24.   print "</BODY>\n";
  25.   print "</HTML>\n";
  26.   exit;
  27. }
  28.  
  29. sub goto_url {
  30.   print "Location: $url\n\n\n";
  31.   exit;
  32. }
  33.  
  34. sub parse_form {
  35.   read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  36.   if ($buffer eq '') {
  37.     $buffer = $ENV{'QUERY_STRING'};
  38.   }
  39.   @pairs = split(/&/, $buffer);
  40.   foreach $pair (@pairs) {
  41.     ($name, $value) = split(/=/, $pair);
  42.     $value =~ tr/+/ /;
  43.     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  44.     
  45.     $input{$name} = $value;
  46.   }
  47. }
  48.  
  49.